home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / src / Tools / glimpsehttp / news / getnews < prev    next >
Text File  |  1995-05-16  |  8KB  |  284 lines
  1. #!/usr/local/bin/perl 
  2. #/****************************************************
  3. #**
  4. #** SOURCE NAME | getnews, (Get News)
  5. #**             | 
  6. #**    SYNOPSIS | getnews [-h hostname] [-p port] [-n cfgfile] [-W timeout]
  7. #**             | 
  8. #** DESCRIPTION | getnews goes to a specified NNTP server
  9. #**             | and saves new news articles
  10. #**             | into directory ./groups/<newsgroup>/
  11. #**             | Please see the NOTES section.
  12. #**             | 
  13. #**     CHANGES | Programmer:         Date:     Reason/Comments
  14. #**             | Jeffrey B. McGough  07-27-92  VERSION 2.0 (pgnews)
  15. #**        | Pavel Klark         03-26-94  VERSION 1.0 (getnews)
  16. #**             | 
  17. #**       NOTES | getnews needs a file named getnews.cfg to read
  18. #**             | its newsgroup and last message number from.
  19. #**             | getnews.cfg format is:
  20. #**             | newsgroup number
  21. #**             | Example:
  22. #**             | comp.unix.wizards 7800
  23. #**             | comp.unix.shell 3203
  24. #**             | comp.unix.questions 546
  25. #**             | 
  26. #**             | getnews is able to process trn-style kill-file commands:
  27. #**             | it locates your kill-file in directory $HOME/News,
  28. #**             |  (See variable $kill_location below).
  29. #**             | and expects all commands to be of format
  30. #**             | /pattern/some-commands. Article is killed (doesn't get
  31. #**             | archived) if any header line matches the pattern.
  32. #**             | 
  33. #**     AUTHORS | Jeffrey B. McGough  mcgough@wrdis01.af.mil
  34. #**         | Pavel Clark, paul@cs.arizona.edu
  35. #**             | 
  36. #****************************************************/
  37.  
  38. unshift(@INC,'/usr1/paul/lib/perl');
  39. $gzip = "/usr/local/bin/gzip -f";
  40.  
  41. $GLIMPSEIDX_LOC='/usr/paul/bin/glimpseindex';
  42. # Your kill-file top directory, the following is trn's default
  43. $kill_location = $ENV{'HOME'} . "/News";
  44.  
  45. require 'sys/socket.ph'; # The way I coded the sockets is this necessary?
  46. require 'getopts.pl';
  47. # -p portnumber : Port to connect to; default 119
  48. # -h host : Server host to connect to
  49. # -n getnews : Name of getnews file; default getnews.cfg
  50. # -W timeout : Timeout wait period for response, sec.; default 900 (= 15min)
  51. $opt_h = $ENV{'NNTPSERVER'};
  52. $opt_h = 'cs.arizona.edu' unless $ENV{'NNTPSERVER'};
  53. $opt_p = 119;
  54. $opt_n = 'getnews.cfg';
  55. $opt_W = 900;
  56. &Getopts ('h:p:n:W:');
  57.  
  58. $VERSION = '2.0';
  59.  
  60. $port = $opt_p; # For NNTP
  61. # HOSTNAME for the server...
  62. $host = $opt_h;
  63. # Pack format...
  64. $sockaddr = 'S n a4 x8';
  65.  
  66. $waittime = $opt_W;
  67.  
  68. $DOMAIN = &AF_INET;
  69. $STYLE = &SOCK_STREAM;
  70.  
  71. $newsfile = $opt_n;
  72. $nnewsfile = "${opt_n}.new";
  73. $newarticles = "groups/newarticles";
  74.  
  75. $rin = $rout = '';
  76.  
  77. ($name, $aliases, $proto) = getprotobyname('tcp');
  78. ($name, $aliases, $type, $len, $hostaddr) = gethostbyname($host);
  79.  
  80. $sock = pack($sockaddr, $DOMAIN, $port, $hostaddr);
  81.  
  82. socket(S, $DOMAIN, $STYLE, $proto) || die $!;
  83. connect(S, $sock) || die $!;
  84. select(S); $| = 1; select(STDOUT);
  85. #set up for select
  86. vec($rin, fileno(S), 1) = 1;
  87. #this select will block until the server gives us something.
  88. $nfound = select($rout=$rin, undef, undef, $waittime);
  89. if ($nfound == 0)
  90. {
  91.     print "Socket timed out...";
  92.     exit 1;
  93. }
  94. $_ = <S>; #Read one line to see if we got a good connection.
  95. if (!/^2../)
  96. {
  97.     print;
  98.     die "Service unavailable";
  99. }
  100. open(GRP, "<$newsfile") || die "Could not open $newsfile: $!";
  101. open(NGRP, ">$nnewsfile") || die "Could not open $nnewsfile: $!";
  102. open(IDXFILE, ">>$newarticles");
  103. $totalcount = 0;
  104. select(NGRP); $| = 1; select(STDOUT);
  105. group: while(<GRP>) {
  106.     if (/^#/) {
  107.         # leave the comment as is
  108.         print NGRP $_;
  109.         next group;
  110.     }
  111.     chop;
  112.     ($grp, $lgot) = split;
  113.     print(S "group $grp\n");
  114.     #this select will block until the server gives us something.
  115.     $nfound = select($rout=$rin, undef, undef, $waittime);
  116.     if ($nfound == 0)
  117.     {
  118.         print "Socket timed out...";
  119.         exit 1;
  120.     }
  121.     $_ = <S>; #Make sure the group change worked...
  122.     ($stat, $num, $first, $last) = split;
  123.     if( $stat !~ /^2../ )
  124.     {
  125.         warn "Bad group $grp: $_";
  126.         print(NGRP "$grp $lgot\n");
  127.         next group;
  128.     }
  129.     #
  130.     # create group directories, if necessary
  131.     #
  132.     -d "groups" || mkdir("groups",0777) ||
  133.         die "Couldn't create directory groups: $!" ;
  134.     -d "groups/$grp" || mkdir("groups/$grp",0777) ||
  135.         die "Couldn't create directory groups/$grp: $!" ;
  136.     -d "indices" || mkdir("indices",0777) ||
  137.         die "Couldn't create directory indices: $!" ;
  138.     -d "indices/$grp" || mkdir("indices/$grp",0777) ||
  139.         die "Couldn't create directory indices/$grp: $!" ;
  140.     #
  141.     # access kill-file (in directory $HOME/News)
  142.     #
  143.     $dir = $kill_location;
  144.     $killfile = $grp;
  145.     $killfile =~ s|\.|/|g;
  146.     $killfile = "$dir/$killfile/KILL";
  147.     if (open(KILL, $killfile))
  148.     {
  149.         @karray = ();
  150.         while (<KILL>) {
  151.             ($dummy,$pattern) = split(m|/|);
  152.             push(@karray,$pattern) if $pattern;
  153.         }
  154.     } else {
  155.         $killfile = undef;
  156.     }
  157.     close(KILL);
  158.     if ( $first > $lgot )
  159.     {
  160.         $lgot = $first;
  161.     }
  162.     $count = 0;
  163.     if ( $lgot < $last )
  164.     {
  165.         article: foreach $art ($lgot..$last)
  166.         {
  167.             print(S "article $art\n");
  168.             #this select will block until the server gives us something.
  169.             $nfound = select($rout=$rin, undef, undef, $waittime);
  170.             if ($nfound == 0)
  171.             {
  172.                 print "Socket timed out...";
  173.                 exit 1;
  174.             }
  175.             $_ = <S>; #get error if one exists
  176.             if(!/^2../)
  177.             {
  178.                 warn "No article $art in $grp\n";
  179.                 next article;
  180.             }
  181. # We now slurp the whole article into the array article...
  182. # HMMM is this good or bad...
  183. # It gives me the WILLIES   [:^)    Jeffrey B. McGough
  184.             @article = ();
  185.             do {
  186. # The next few lines have been commented out because they don't work
  187. # JBM 07-27-92
  188. #    $nfound = select($rout=$rin, undef, undef, $waittime);
  189. #    if ($nfound == 0)
  190. #    {
  191. #        print "Socket timed out...";
  192. #        exit 1;
  193. #    }
  194.                 $lgot = $art;
  195.                 $_ = <S>;
  196.                 s/\r//g;
  197.                 if( $_ ne ".\n") {
  198.                     push(@article,$_);
  199.                 } else {
  200.                     push(@article,"\n");
  201.                 }
  202.             } until $_ eq ".\n";
  203.             if ( !&desc ) {
  204.                 # header matches kill-file
  205.                 next article;
  206.             }
  207.             ++$count;
  208.             ++$totalcount;
  209.         }
  210.     } else {
  211.         $lgot -= 1;
  212.     }
  213.     $lgot += 1;
  214.     print(NGRP "$grp $lgot\n");
  215.     print "$grp: $count new articles\n";
  216.     if ($count>0) {
  217.         $cmd = "exec $GLIMPSEIDX_LOC -o -z -H indices/$grp ".
  218.             "groups/$grp >/dev/null";
  219.         system "$cmd";
  220.     }
  221. }
  222. close(NGRP);
  223. close(GRP);
  224. close(IDXFILE);
  225. if ($totalcount>0) {
  226.     $cmd = "build_idx &";
  227.     system "$cmd";
  228. } else {
  229.     unlink("$newarticles");
  230. }
  231. rename ($newsfile, "$newsfile.old") ||
  232.     warn ("Unable to rename $newsfile to ${newsfile}.old\n");
  233. rename ($nnewsfile, $newsfile) ||
  234.     warn ("Unable to rename ${nnewsfile} to ${newsfile}\n");
  235. print( S "quit\n");
  236. close(S);
  237.  
  238. # We parse through @article to extract header information
  239. #  and then save the article
  240. # Returns article no, or empty string if article is to be killed
  241. sub desc
  242. {
  243.     local($pattern,$author,$subject,$ID,$date,$filename);
  244.     # global parameters: $grp, $art, @article, @karray
  245.  
  246.     scan: foreach (@article) {
  247.         last scan if /^\n$/;
  248.         foreach $pattern (@karray) {
  249.             if (/$pattern/i) {
  250.                 return undef;
  251.             }
  252.         }
  253.         s/\s+/ /;
  254.         if ( /^From: (.*)/ ) {
  255.             $author = $1;
  256.             if ($author =~ /([\w\d][-+\w\d.]*@[\w\d][-\w\d.]*)/) {
  257.                 $address = $1;
  258.             } else {
  259.                 $address = $author;
  260.             }
  261.         } elsif (/^Message-ID: \<?([^\s\>]*)/) {
  262.             $ID=$1;
  263.         } elsif (/^Subject: (.*)/) {
  264.             $subject=$1;
  265.         } elsif (/^Date: (.*)/) {
  266.             $date=$1;
  267.         }
  268.     }
  269.     # good article, now open output file...
  270.     $filename = "/$grp/$art";
  271.     $file = "groups$filename";
  272.     open(OUTFILE, ">$file") ||
  273.         die "Could not open $file";
  274.     print OUTFILE @article;
  275.     close(OUTFILE);
  276.     if ($grp =~ /soc.culture/) {
  277.         system("$gzip $file");
  278.         $filename .= ".gz";
  279.     }
  280.     # Write header information
  281.     print IDXFILE "$filename\t$ID\t$address\t$author\t$subject\t$date\n";
  282.     return $art;
  283. }
  284.